home *** CD-ROM | disk | FTP | other *** search
- (***************************************************************************
-
- $RCSfile: TextFieldGadget.mod $
- Description: Interface to triton.library
-
- Created by: Helmuth Ritzer
- $Revision: 2.0 $
- $Author: hr $
- $Date: 1995/01/21 16:15:40 $
-
- Copyright © 1994 Mark Thomas
- Translated for Oberon-A by Helmuth Ritzer, June 1994
- Minor modifications for Oberon-A Release 1.4 by Frank Copeland.
- Adapted to V2.0 by Helmuth Ritzer, Jan 1995
-
- ***************************************************************************)
-
- <* STANDARD- *>
-
- MODULE [2] TextFieldGadget;
-
- IMPORT SYS := SYSTEM, Kernel, E := Exec, I := Intuition, U := Utility;
-
-
- CONST
- tagBase = U.user + 04000000H;
-
- (* V1.0 *)
- text * = tagBase + 1;
- insertText * = tagBase + 2;
- textFont * = tagBase + 3;
- delimiters * = tagBase + 4;
- top * = tagBase + 5;
- blockCursor * = tagBase + 6;
- size * = tagBase + 7;
- visible * = tagBase + 8;
- lines * = tagBase + 9;
- noGhost * = tagBase + 10;
- maxSize * = tagBase + 11;
- border * = tagBase + 12;
- textAttr * = tagBase + 13;
- fontStyle * = tagBase + 14;
- up * = tagBase + 15;
- down * = tagBase + 16;
- alignment * = tagBase + 17;
- vCenter * = tagBase + 18;
- ruledPaper * = tagBase + 19;
- paperPen * = tagBase + 20;
- inkPen * = tagBase + 21;
- linePen * = tagBase + 22;
- userAlign * = tagBase + 23;
- spacing * = tagBase + 24;
- clipStream * = tagBase + 25;
- clipStream2 * = tagBase + 26;
- blinkRate * = tagBase + 27;
- inverted * = tagBase + 28;
- partial * = tagBase + 29;
- cursorPos * = tagBase + 30;
-
- (* V2.0 *)
- readOnly * = tagBase + 31;
- modified * = tagBase + 32;
- acceptChars * = tagBase + 33;
- rejectChars * = tagBase + 34;
- passCommand * = tagBase + 35;
- lineLength * = tagBase + 36;
- maxSizeBeep * = tagBase + 37;
- deleteText * = tagBase + 38;
- selectSize * = tagBase + 39;
- copy * = tagBase + 40;
- copyAll * = tagBase + 41;
- cut * = tagBase + 42;
- paste * = tagBase + 43;
- erase * = tagBase + 44;
- undo * = tagBase + 45;
-
- (*
- * TEXTFIELD_Border
- *
- * See docs for width and height sizes these borders are
- *)
-
- borderNone * = 0;
- borderBevel * = 1;
- borderDoubleBevel * = 2;
-
- (*
- * TEXTFIELD_Alignment
- *)
-
- alignLeft * = 0;
- alignCenter * = 1;
- alignRight * = 2;
-
-
- TYPE
- TextFieldBasePtr * = POINTER TO TextFieldBase;
- TextFieldBase * = RECORD (E.Library) END;
-
- CONST
- name * = "gadgets/textfield.gadget";
-
-
- VAR
- base * : TextFieldBasePtr;
- textFieldClass * : I.IClassPtr; (* Use this for NewObject() calls *)
-
- PROCEDURE GetClass* [base,-30] ()
- : I.IClassPtr;
-
- (*-- Library Base variable --------------------------------------------*)
-
- <*$LongVars-*>
-
- PROCEDURE* [0] CloseLib (VAR rc : LONGINT);
- BEGIN
- IF base # NIL THEN E.CloseLibrary (base) END;
- END CloseLib;
-
- PROCEDURE [0] OpenLib * (mustOpen : BOOLEAN);
- BEGIN
- IF base = NIL THEN
- base := SYS.VAL(TextFieldBasePtr, E.OpenLibrary (name, 0));
- IF base # NIL THEN Kernel.SetCleanup (CloseLib); textFieldClass := GetClass();
- ELSIF mustOpen THEN HALT (100)
- END
- END
- END OpenLib;
-
- BEGIN
- base := NIL; textFieldClass := NIL;
- END TextFieldGadget.
-